Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/0292.ZIP/MAILMEN.ARC/PRINTCAT.PRG

Text File | 1985-12-21 | 6KB | 228 lines

* Converted to Dbase III by Bill Simpson 6/7/85 [phone]
*!!*       dBASE CONVERT - dBASE III File Conversion Aid  v1.0 6/14/84
*
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
STORE .T. TO BEVEL
DO WHILE BEVEL
  STORE ' ' TO ANS1
  @ 10,5 say "Do you wish to print a list of friends or business (F or B) ?"
  @ 10,75 GET ANS1
  READ
  CLEAR GETS
  IF UPPER(ANS1) = 'F' .OR. UPPER(ANS1) = 'B'
    STORE .F. TO BEVEL
  ENDIF
ENDDO
IF UPPER(ANS1) = 'F'
  USE MAIL
  STORE .T. TO BLUE
  DO WHILE BLUE
    STORE ' ' TO INDEX1
    CLEAR
    @ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?"
    @ 10,75 GET INDEX1
    READ
    CLEAR GETS
    IF UPPER(INDEX1)= 'Y'
      INDEX ON LAST TO LAST
      STORE .F. TO BLUE
    ELSE
      IF UPPER(INDEX1) = 'N'
        STORE .F. TO BLUE
      ENDIF
    ENDIF
  ENDDO
  STORE 60 TO N
  CLEAR
  STORE 0 TO INDEX2
  USE MAIL INDEX LAST
  GO TOP
  SET PRINT ON
  ? CHR(15)
  STORE .T. TO TRUE
  DO WHILE TRUE
    ? 'NAME','                                    ','|', 'COMPANY', '            ';
    ,'         ','|', 'OFFICE TEL. ','|', 'HOME TEL.'
    ? '====','                                    ','|', '=======', '            ';
    ,'         ','|', '=========== ','|', '========='
    DO WHILE .NOT. EOF() .AND. INDEX2 < N
      IF FRIEND <> ' '
        ? LAST, FIRST,'|', COMPANY,'|', TEL_WRK,'|', TEL_HM
        STORE INDEX2 +1 TO INDEX2
      ENDIF
      SKIP
    ENDDO
    IF INDEX2 >= N
      EJECT
      STORE 0 TO INDEX2
    ENDIF
    IF EOF() = .T.
      STORE .F. TO TRUE
    ENDIF
  ENDDO
  EJECT
  ? CHR(18)
  SET PRINT OFF
  RETURN
ENDIF
IF UPPER(ANS1) = 'B'
  STORE .T. TO RIGHT
  DO WHILE RIGHT
    STORE ' ' TO P
    CLEAR
    @ 10,5 SAY "Press 'A' To Print All Categories"
    @ 12,5 SAy "Press 'S' to print selected categories"
    @ 12,70 get P
    READ
    CLEAR GETS
    IF UPPER(P) = 'A' .OR. UPPER(P) = 'S'
      STORE .F. TO RIGHT
    ENDIF
  ENDDO
  IF UPPER(P) = 'A'
    STORE 60 TO N
    CLEAR
    USE MAIL
    STORE .T. TO BLUE
    DO WHILE BLUE
      STORE ' ' TO INDEX1
      CLEAR
      @ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?"
      @ 10,75 GET INDEX1
      READ
      CLEAR GETS
      IF UPPER(INDEX1) = 'Y'
        INDEX ON COMPANY TO COMP
        STORE .F. TO BLUE
      ELSE
        IF UPPER(INDEX1) = 'N'
          STORE .F. TO BLUE
        ENDIF
      ENDIF
    ENDDO
    STORE 0 TO INDEX2
    USE MAIL INDEX COMP
    GO TOP
    SET PRINT ON
    ? CHR(15)
    STORE .T. TO TRUE
    DO WHILE TRUE
      ? 'COMPANY','                      ','|', 'NAME', '                          ';
      ,'         ','|','OFFICE TEL. ','|', 'HOME TEL.'
      ? '=======','                      ','|', '====', '                          ';
      ,'         ','|','=========== ','|', '========='
      DO WHILE .NOT. EOF() .AND. INDEX2 < N
        IF FRIEND = ' '
          ? COMPANY,'|', FIRST, LAST,'|', TEL_WRK,'|', TEL_HM
          STORE INDEX2 +1 TO INDEX2
        ENDIF
        SKIP
      ENDDO
      IF INDEX2 >= N
        EJECT
        STORE 0 TO INDEX2
      ENDIF
      IF EOF()
        STORE .F. TO TRUE
      ENDIF
    ENDDO
    EJECT
    ? CHR(18)
    SET PRINT OFF
    RETURN
  ENDIF
  IF UPPER(P) = 'S'
    STORE .T. TO CONTINUE
    DO WHILE CONTINUE
      SET PRINT OFF
      STORE .T. TO LEVEL
      DO WHILE LEVEL
        STORE ' ' TO ANS
        STORE ' ' TO CAT
        CLEAR
        ?
        ?
        ?
        ?
        *!! There will be no automatic colon following this prompt string.
        ACCEPT "What Priority Level Are You Searching (1,2, OR 3) ?" TO ANS
        ?
        ?
        *!! There will be no automatic colon following this prompt string.
        ACCEPT "What Category Are You Looking For ?" TO CAT
        IF ANS = '1' .OR. ANS = '2' .OR. ANS = '3'
          STORE 'PROF'-ANS TO PROF
          STORE .F. TO LEVEL
        ENDIF
      ENDDO
      CLEAR
      STORE UPPER(CAT) TO CAT
      USE MAIL
      STORE .T. TO TRUE
      DO WHILE TRUE
        STORE ' ' TO INDEX
        @ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?" GET INDEX
        READ
        IF UPPER(INDEX)= 'Y'
          INDEX ON &PROF TO &PROF
          STORE .F. TO TRUE
        ELSE
          IF UPPER(INDEX) = 'N'
            STORE .F. TO TRUE
          ENDIF
        ENDIF
      ENDDO
      USE MAIL INDEX &PROF
      *!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
      FIND &CAT
      STORE 60 TO N
      CLEAR
      STORE 0 TO INDEX
      SET PRINT ON
      ? CHR(15)
      STORE .T. TO TRUE
      DO WHILE TRUE
        ? "&CAT"
        ? "------------------------------"
        ? 'COMPANY','                      ','|', 'NAME', '                          ';
        ,'         ','|','OFFICE TEL. ','|', 'HOME TEL.'
        ? '=======','                      ','|', '====', '                          ';
        ,'         ','|','=========== ','|', '========='
        DO WHILE .NOT. EOF() .AND. &PROF = '&CAT' .AND. INDEX < N
          ? COMPANY,'|', FIRST, LAST,'|', TEL_WRK,'|', TEL_HM
          STORE INDEX +1 TO INDEX
          SKIP
        ENDDO
        IF INDEX >= N
          EJECT
          STORE 0 TO INDEX
        ENDIF
        IF EOF() = .T.
          STORE .F. TO TRUE
        ENDIF
        IF &PROF <> '&CAT'
          STORE .F. TO TRUE
        ENDIF
      ENDDO
      CLEAR
      STORE ' ' TO CONT
      @ 10,5 SAY 'Do you wish to continue ?'
      @ 12,5 SAY "Press 'N' to Return to the Menu"
      @ 14,5 SAY 'Press any other key to continue'
      @ 14,40 GET CONT
      READ
      CLEAR GETS
      IF UPPER(CONT) = 'N'
        EJECT
        ? CHR(18)
        SET PRINT OFF
        STORE .F. TO CONTINUE
        RETURN
      ELSE
      ENDDO
    ENDIF
  ENDIF